home *** CD-ROM | disk | FTP | other *** search
/ The World's Largest Collection of Windows Software / The World's Largest Collection of Windows Software - Disc 1.iso / connect / _b1 / mrun211 / mrun211g.was < prev    next >
Text File  |  1993-05-01  |  45KB  |  1,685 lines
  1. ;MailRun v2.11:  Part G, domailrun
  2. ;1992-1993 Gerald P. Sully, all rights reserved.
  3.  
  4. #COMMENT
  5. **************************************************************************
  6. **************************************************************************
  7. * 
  8. * The following procedures form the engine of the script.  First
  9. * makedir() is called to create a dialing directory for BBSs listed
  10. * in the *.MRN file that have pending items.  Each BBS is called,
  11. * and on connection, each pending item listed for that BBS is executed
  12. * by dobbs().  These tasks are performed by sendmail(), getmail(),
  13. * ulfile(), dlfile(), and sendcommand().  As each task is completed,
  14. * the task list window is updated.
  15. * 
  16. * While online, the key procedure is holding() which keeps track of the
  17. * length of time the board has been inactive, checks for dropped carrier
  18. * and obtains the current line from the terminal screen so that it can
  19. * be parsed by the various procedures that respond to prompts.  The
  20. * latter include checkbaseset(), checkcommandprompt(), checkmailprompt()
  21. * and the like.
  22. * 
  23. **************************************************************************
  24. **************************************************************************
  25. #ENDCOMMENT
  26.  
  27. #define MRUN211G
  28. #define MRUN211AG
  29.  
  30. #define GOTOFILE 1
  31. #define GOTOMAIN 0
  32.  
  33. string MainBoxTabs, prompt
  34. integer xferstatus, holdstatus, foundstatus
  35.  
  36. #include "MRUN211.h"
  37.  
  38.  
  39. #comment
  40. *********************************************************************
  41. * 
  42. * MAIN()
  43. * 
  44. * Calls menudim(), checkchild(), maketasklist(), dobbs()
  45. * mailrunbox(), parsedialog(), makequeue(), readbbs(),
  46. * makefullname(), findstring(), capturescreen()
  47. * 
  48. * Main first calls the initialization routines, then puts
  49. * up the main dialog box and dispatches each requested
  50. * action.
  51. * 
  52. *********************************************************************
  53. #endcomment
  54.  
  55. proc main
  56. string DialString, PhoneNum, ComString, ComMsg, BBSName
  57. string  CnctFail1, CnctFail2, CnctFail3, CnctFail4, CnctFail5
  58. string char
  59. integer ComStringLength
  60. integer Attempts, MaxAttempts, DialOutTime, RingInterrupt
  61. integer i, j, n
  62. integer FirstCall
  63.     menudim()
  64.     checkchild()
  65.     profilerd MailRunIni "MailRun" "MailRunDir" MailRunDir
  66.     TaskList = makefullname(TempDir, "TASKLIST.TMP")
  67.     findfirst MailRun
  68.     MailRunTrunc = $FILENAME
  69.     maketasklist()
  70.     mailrunbox()
  71.     makequeue()
  72.     ;interface is turned on by makequeue
  73.     when dialog call parsedialog
  74.     profilerd MailRun "MailRun" "LogRun" LogRun
  75.     if LogRun
  76.         profilerd MailRun "MailRun" "AnsiInLog" AnsiInLog
  77.         if AnsiInLog
  78.             set capture mode append RAW
  79.         else
  80.             set capture mode append VISUAL
  81.         endif
  82.         capture ON
  83.     endif
  84.     profilerd MailRun "MailRun" "DialAttempts" MaxAttempts
  85.     fetch modem nocnct1 CnctFail1
  86.     fetch modem nocnct2 CnctFail2
  87.     fetch modem nocnct3 CnctFail3
  88.     fetch modem nocnct4 CnctFail4
  89.     fetch modem nocnct5 CnctFail5
  90.     Attempts = 1
  91.     FirstCall = 1
  92.     while Attempts <= MaxAttempts
  93.         itoa Attempts AttemptNum
  94.         updatedlg 64
  95.         ;Keep dialing until the maximum number of attempts has been made
  96.         ;reread MaxAttempts on each loop in case the user changes settings
  97.         profilerd MailRun "MailRun" "DialAttempts" MaxAttempts
  98.         n = 1
  99.         DialString = getdialstring(&n)
  100.         if n == 0
  101.             exitwhile
  102.         endif
  103.         while not NULLSTR DialString
  104.             ;Loop until all numbers have been called
  105.             set aspect rxdata ON
  106.             rxflush
  107.             if FirstCall != 1
  108.                 ;Don't pause if this is the first call in the loop
  109.                 profilerd MailRun "MailRun" "DialPause" j
  110.                 profilerd MailRun "MailRun" "RingInterrupt" RingInterrupt 
  111.                 while j > 0
  112.                     statmsg "Last Message:  %s      Pausing  %d" ComMsg j
  113.                     pause 1
  114.                     j--
  115.                     ComStringLength = $RXCOUNT
  116.                     comgets ComString ComStringLength
  117.                     if RingInterrupt && findstring(ComString, "RING")
  118.                         capturescreen()
  119.                         capturestr \
  120.                             "`r`n`r`n**** Interrupted by Incoming Call ****`r`n`r`n"
  121.                         statmsg "Mailrun interrupted by incoming call"
  122.                         capture OFF
  123.                         exit
  124.                     endif
  125.                 endwhile
  126.             else
  127.                 FirstCall = 0
  128.             endif
  129.             ;Dial the BBS
  130.             strextract PhoneNum DialString "`t" 0
  131.             strextract char DialString "`t" 1
  132.             atoi char i
  133.             BBS = readbbs(i)
  134.             profilerd MailRun BBS "BBSName" BBSName
  135.             strfmt ComString "ATDT%s`r" PhoneNum
  136.             strlen ComString ComStringLength
  137.             computs ComString ComStringLength
  138.             ;rxdata must be on in order to get characters from the modem
  139.             ComString = ""
  140.             ComMsg = ""
  141.             profilerd MailRun "MailRun" "DialTimeOut" DialOutTime
  142.             while (!$CARRIER) && (DialOutTime > 0)
  143.                 ;Loop until a connection is made, timeout is reached, or a
  144.                 ;negative connect message is received
  145.                 ComStringLength = $RXCOUNT
  146.                 comgets ComString ComStringLength
  147.                 if strfind ComString CnctFail1
  148.                     ComMsg = CnctFail1
  149.                     exitwhile
  150.                 elseif strfind ComString CnctFail2
  151.                     ComMsg = CnctFail2
  152.                     exitwhile
  153.                 elseif strfind ComString CnctFail3
  154.                     ComMsg = CnctFail3
  155.                     exitwhile
  156.                 elseif strfind ComString CnctFail4
  157.                     ComMsg = CnctFail4
  158.                     exitwhile
  159.                 elseif strfind ComString CnctFail5
  160.                     ComMsg = CnctFail5
  161.                     exitwhile
  162.                 endif
  163.                 rxflush
  164.                 statmsg "Dialing %s      %s     Waiting %d" \
  165.                     PhoneNum BBSName DialOutTime
  166.                 pause 1
  167.                 DialOutTime--
  168.             endwhile
  169.             set aspect rxdata OFF
  170.             if DialOutTime == 0
  171.                 ;If dial timed out...
  172.                 hangup
  173.                 ComMsg = "TIMEOUT"
  174.             endif
  175.             if $CARRIER
  176.                 ;if connected to a BBS...
  177.                 statmsg "Connected to %s" BBSName
  178.                 dobbs()
  179.                 makequeue()
  180.                 statmsg ""
  181.                 FirstCall = 1
  182.                 n--
  183.             endif
  184.             n++
  185.             DialString = getdialstring(&n)
  186.         endwhile
  187.         Attempts++
  188.     endwhile
  189.     capture OFF
  190.     statmsg ""
  191. endproc
  192.  
  193.  
  194. #comment
  195. *********************************************************************
  196. * 
  197. * DOBBS()
  198. * 
  199. * Called by main()
  200. * 
  201. * Calls readitem(), writeitem(), sendscript(), logoff(), fileexit()
  202. * maketasklist(), gettaskstring(), getcommandprompt(),
  203. * getmail(), sendmail(), dlfile(), ulfile(), sendcommand(),
  204. * 
  205. * Dispatches pending tasks for the BBS to which MailRun
  206. * is connected.
  207. * 
  208. *********************************************************************
  209. #endcomment
  210.  
  211. proc dobbs
  212. string Pending, TaskType, BBSName, BBSType
  213. integer FailCode, j
  214.     ;Return to this point with a FailCode of 1 if carrier
  215.     ;is lost or the BBS times out
  216.     Failcode = 0
  217.     setjmp ErrorFail FailCode
  218.     if FailCode == 0
  219.         profilerd MailRun BBS "BBSType" BBSType
  220.         profilerd MailRun BBS "BBSName" BBSName
  221.         profilerd MailRun "MailRun" "IdleTimeout" IdleTimeout
  222.         ;Assume login to Conference 0
  223.         CurrentConf = "0"
  224.         Conf = "0"
  225.         ;Highlight the current BBS in the task list
  226.         TaskItem = gettaskstring(BBS, 0)
  227.         updatedlg 16
  228.  
  229.         ;The first item must be read before the first holding()
  230.         ;(which occurs in getcommandprompt()) in case an error occurs.
  231.         j = 1
  232.         Item = readitem(BBS, j)
  233.         getcommandprompt()
  234.         while not NULLSTR Item
  235.             ;Loop through each Item for this BBS
  236.             TaskItem = gettaskstring(BBS, j)
  237.             updatedlg 16
  238.             strextract Pending Item "," 0
  239.             if strcmpi Pending "1"
  240.                 ;If the item is pending, execute it
  241.                 strextract TaskType Item "," 2
  242.                 switch TaskType
  243.                     case "GetMail"
  244.                         statmsg "Getting Mail Packet"
  245.                         getmail()
  246.                     endcase
  247.                     case "SendMail"
  248.                         statmsg "Sending Reply Packet"
  249.                         sendmail()
  250.                     endcase
  251.                     case "GetFile"
  252.                         statmsg "Downloading File"
  253.                         dlfile()
  254.                     endcase
  255.                     case "SendFile"
  256.                         statmsg "Uploading File"
  257.                         ulfile()
  258.                     endcase
  259.                     case "SendCommand"
  260.                         statmsg "Sending Command"
  261.                         sendcommand()
  262.                     endcase
  263.                     case "SendScript"
  264.                         statmsg "Executing Script"
  265.                         sendscript()
  266.                     endcase
  267.                 endswitch
  268.                 ;Update the task list
  269.                 TaskItem = gettaskstring(BBS, j)
  270.                 writeitem(BBS, j, Item)
  271.                 taskfilefwd(TaskItem)
  272.                 TaskItem = gettaskstring(BBS, j)
  273.                 fputs TaskFile TaskItem
  274.                 taskfileend()
  275.                 ItemR--
  276.                 updatecount()
  277.                 updatedlg 80
  278.             endif
  279.             j++
  280.             Item = readitem(BBS, j)
  281.         endwhile
  282.         getcommandprompt()
  283.     else
  284.         ;If timeout or loss of carrier
  285.         ;Change unfinished items to errors
  286.         while not NULLSTR Item
  287.             strextract Pending Item "," 0
  288.             if strcmpi Pending "1"
  289.                 strupdt Item "2" 0 1
  290.                 writeitem(BBS, j, Item)
  291.             endif
  292.             j++
  293.             Item = readitem(BBS, j)
  294.         endwhile
  295.         maketasklist()
  296.         j--
  297.         Item = readitem(BBS, j)
  298.         TaskItem = gettaskstring(BBS, j)
  299.         updatedlg 80
  300.     endif
  301.     statmsg "Logging off"
  302.     logoff()
  303.     if $CARRIER
  304.         ;If still connected after logoff...
  305.         errormsg "Unable to drop carrier; aborting..."
  306.         ;abort the mailrun
  307.         fileexit()
  308.     endif
  309. endproc
  310.  
  311.  
  312. #comment
  313. *********************************************************************
  314. * 
  315. * MAKEQUEUE()
  316. * 
  317. * Called by main(), parsedialog()
  318. * 
  319. * Calls openfile(), readbbs(), checkpending(),
  320. * interfaceon(), interfaceoff(), makefullname()
  321. * 
  322. * Creates a file of phone numbers for BBSs that have
  323. * pending items in the current mailrun.
  324. * 
  325. *********************************************************************
  326. #endcomment
  327.  
  328. proc makequeue
  329. string PhoneNum, Number_X, QueueList, BBSid
  330. integer i, j
  331.     interfaceoff()
  332.     QueueList = makefullname(TempDir, "QUEUE.TMP")
  333.     openfile(QueueListFile, QueueList, _CREATE, _NORMAL)
  334.     i = 1
  335.     BBSid = readbbs(i)
  336.     ;Loop through each BBS
  337.     while not NULLSTR BBSid
  338.         if checkpending(BBSid)
  339.             ;If the BBS has pending items...
  340.             j = 1
  341.             strfmt Number_X "Number_%d" j
  342.             profilerd MailRun BBSid Number_X PhoneNum
  343.             ;Loop through each phone number
  344.             while not NULLSTR PhoneNum
  345.                 fstrfmt QueueListFile "%s`t%d`r`n" PhoneNum i
  346.                 j++
  347.                 strfmt Number_X "Number_%d" j
  348.                 profilerd MailRun BBSid Number_X PhoneNum
  349.             endwhile
  350.         endif
  351.         i++
  352.         BBSid = readbbs(i)
  353.     endwhile
  354.     fclose QueueListFile
  355.     interfaceon()
  356. endproc
  357.  
  358.  
  359. #comment
  360. *********************************************************************
  361. * 
  362. * GETDIALSTRING()
  363. * 
  364. * Called by main()
  365. * 
  366. * Calls makefullname(), interfaceon(), interfaceoff(),
  367. * openfile()
  368. * 
  369. * Gets a DialString from the queue.  The string contains
  370. * a phone number and a bbs coordinate.
  371. * 
  372. *********************************************************************
  373. #endcomment
  374.  
  375. func getdialstring : string
  376. intparm n
  377. integer i
  378. string DialString, QueueList
  379.     interfaceoff()
  380.     DialString = ""
  381.     QueueList = makefullname(TempDir, "QUEUE.TMP")
  382.     openfile(QueueListFile, QueueList, _READWRITE, _TEXT)
  383.     i = 1
  384.     while i <= n
  385.         fgets QueueListFile DialString
  386.         if NULLSTR DialString
  387.             n = 0
  388.             exitwhile
  389.         endif
  390.         i++
  391.     endwhile
  392.     fclose QueueListFile
  393.     interfaceon()
  394.     return DialString
  395. endfunc
  396.  
  397.  
  398. #comment
  399. *********************************************************************
  400. * 
  401. * GETCOMMANDPROMPT()
  402. * 
  403. * Called by dobbs(), getconfprompt(), getotherprompt(),
  404. * ulfile(), dlfile(), sendcommand(), sendscript()
  405. * 
  406. * Calls holding(), checkcommandprompt()
  407. * 
  408. * Responds to prompts until the "Command" prompt is received.
  409. * 
  410. *********************************************************************
  411. #endcomment
  412.  
  413. proc getcommandprompt
  414.     when quiet 1 call checkcommandprompt
  415.     holding()
  416.     clearwhen quiet
  417. endproc
  418.  
  419.  
  420. #comment
  421. *********************************************************************
  422. * 
  423. * CHECKCOMMANDPROMPT()
  424. * 
  425. * Called by getcommandprompt()
  426. * 
  427. * Calls checkbaseset(), findstring(), endhold()
  428. * 
  429. * Checks the prompt and sends the appropriate response.
  430. * 
  431. *********************************************************************
  432. #endcomment
  433.  
  434. proc checkcommandprompt
  435. string NamePrompt, UserName, BBSType
  436. string PWordPrompt, PWord, FilePrompt
  437. string MailPrompt, CommandPrompt, MsgMenuPrompt
  438.     profilerd MailRun BBS "BBSType" BBSType
  439.     profilerd MailRun BBS "NamePrompt" NamePrompt
  440.     profilerd MailRun BBS "PWordPrompt" PWordPrompt
  441.     profilerd MailRun BBS "FilePrompt" FilePrompt
  442.     profilerd MailRun BBS "MailPrompt" MailPrompt
  443.     profilerd MailRun BBS "CommandPrompt" CommandPrompt
  444.     profilerd MailRun BBS "MsgMenuPrompt" MsgMenuPrompt
  445.     if !(checkbaseset())
  446.         if findstring(prompt, MailPrompt) || \
  447.             (findstring(BBSType, "WildCat") && \
  448.             findstring(prompt, MsgMenuPrompt))
  449.             transmit "q^M"
  450.         elseif findstring(BBSType, "WildCat") && \
  451.             findstring(prompt, "Join conference")
  452.             transmit Conf
  453.             transmit "^M"
  454.         elseif findstring(prompt, NamePrompt)
  455.             profilerd MailRun BBS "UserName" UserName
  456.             transmit UserName
  457.             transmit "^M"
  458.         elseif findstring(prompt, PWordPrompt)
  459.             profilerd MailRun BBS "PWord" PWord
  460.             transmit PWord
  461.             transmit "^M"
  462.         elseif findstring(prompt, "Escape") || findstring(prompt, " ESC ")
  463.             ;send escape character
  464.             computc 0x1B
  465.           if findstring(prompt, "twice") || findstring(prompt, "two")
  466.                 ;pause 50 milliseconds
  467.                 mspause 50
  468.                 computc 0x1B
  469.             endif
  470.         elseif findstring(prompt, CommandPrompt) || \
  471.             findstring(prompt, FilePrompt)
  472.             endhold()
  473.         endif
  474.     endif
  475. endproc
  476.  
  477.  
  478. #comment
  479. *********************************************************************
  480. * 
  481. * GETCONFPROMPT()
  482. * 
  483. * Called by ulfile(), dlfile()
  484. * 
  485. * Calls getcommandprompt(), findstring()
  486. * 
  487. * Changes conferences if necessary.
  488. * 
  489. *********************************************************************
  490. #endcomment
  491.  
  492. proc getconfprompt
  493. string BBSType
  494.     profilerd MailRun BBS "BBSType" BBSType
  495.     if not strcmpi CurrentConf Conf
  496.         ;If we have to change conferences...
  497.         if findstring(BBSType, "WildCat")
  498.             transmit "j^M"
  499.         elseif findstring(BBSType, "PCBoard")
  500.             transmit "j;"
  501.             transmit Conf
  502.             transmit "^M"
  503.         endif
  504.         getcommandprompt()
  505.         CurrentConf = Conf
  506.     endif
  507. endproc
  508.  
  509.  
  510. #comment
  511. *********************************************************************
  512. * 
  513. * CHECKMAILPROMPT()
  514. * 
  515. * Called by getmail(), sendmail()
  516. * 
  517. * Calls endhold(), findstring(), checkbaseset()
  518. * 
  519. * Opens the mail door and gets the mail prompt.
  520. * 
  521. *********************************************************************
  522. #endcomment
  523.  
  524. proc checkmailprompt
  525. string MailPrompt, CommandPrompt, MailDoor, FilePrompt
  526. string BBSType, MsgMenuPrompt
  527.     profilerd MailRun BBS "BBSType" BBSType
  528.     profilerd MailRun BBS "MsgMenuPrompt" MsgMenuPrompt
  529.     profilerd MailRun BBS "MailPrompt" MailPrompt
  530.     profilerd MailRun BBS "CommandPrompt" CommandPrompt
  531.     profilerd MailRun BBS "FilePrompt" FilePrompt
  532.     if !(checkbaseset())
  533.         if findstring(BBSType, "WildCat") && \
  534.             (findstring(prompt, CommandPrompt) || findstring(prompt, FilePrompt))
  535.             transmit "M^M"
  536.         elseif findstring(prompt, MailPrompt)
  537.             endhold()
  538.         elseif (findstring(prompt, CommandPrompt) && \
  539.             (findstring(BBSType, "PCBoard") || findstring(BBSType, "RBBS"))) || \
  540.             (findstring(BBSType, "WildCat") && findstring(prompt, MsgMenuPrompt))
  541.             profilerd MailRun BBS "MailDoor" MailDoor
  542.             transmit MailDoor
  543.             transmit "^M"
  544.         endif
  545.     endif
  546. endproc
  547.  
  548.  
  549. #comment
  550. *********************************************************************
  551. * 
  552. * CHECKDESCPROMPT()
  553. * 
  554. * Called by ulfile(), dlfile()
  555. * 
  556. * Calls findstring(), endhold(), checkbaseset()
  557. * 
  558. * Checks for presense of the upload description prompt.
  559. * Sets promptstatus to 0 if the file already on the board.
  560. * 
  561. *********************************************************************
  562. #endcomment
  563.  
  564. proc checkdescprompt
  565. string ULDescPrompt, DLUnavPrompt, CommandPrompt, FilePrompt, BBSType
  566.     profilerd MailRun BBS "BBSType" BBSType
  567.     profilerd MailRun BBS "ULDescPrompt" ULDescPrompt
  568.     profilerd MailRun BBS "DLUnavPrompt" DLUnavPrompt
  569.     profilerd MailRun BBS "CommandPrompt" CommandPrompt
  570.     profilerd MailRun BBS "FilePrompt" FilePrompt
  571.     if !(checkbaseset())
  572.         if findstring(prompt, "file # 2") || findstring(prompt, "file #2") || \
  573.             findstring(prompt, "Keywords? [")
  574.             transmit "^M"
  575.         elseif (findstring(BBSType, "WildCat") && \
  576.             (findstring(prompt, "password protect") || \
  577.             findstring(prompt, "detailed") || \
  578.             findstring(prompt, "last download"))) || \
  579.             (findstring(BBSType, "RBBS") && \
  580.             findstring(prompt, "Extended description"))
  581.             transmit "n^M"
  582.         elseif findstring(prompt, "after upload")
  583.             transmit "c^M"
  584.         elseif findstring(BBSType, "RBBS") && findstring(prompt, "To A)ll")
  585.             transmit "a^M"
  586.             foundstatus = 1
  587.             endhold()
  588.         elseif findstring(prompt, ULDescPrompt)
  589.             foundstatus = 1
  590.             endhold()
  591.         elseif findstring(prompt, DLUnavPrompt) || \
  592.             findstring(prompt, "file # 1") || findstring(prompt, "file #1") || \
  593.             findstring(prompt, CommandPrompt) || findstring(prompt, FilePrompt)
  594.             if findstring(BBSType, "Auntie") && !(findstring(prompt, FilePrompt))
  595.                 transmit "q^M"
  596.             endif
  597.             foundstatus = 0
  598.             endhold()
  599.         endif
  600.     endif
  601. endproc
  602.  
  603.  
  604. #comment
  605. *********************************************************************
  606. * 
  607. * GOTULDLPROMPT()
  608. * 
  609. * Called by ulfile()
  610. * 
  611. * Releases the hold when the upload prompt is received.
  612. * 
  613. *********************************************************************
  614. #endcomment
  615.  
  616. proc gotuldlprompt
  617.     foundstatus = 1
  618.     endhold()
  619. endproc
  620.  
  621.  
  622. #comment
  623. *********************************************************************
  624. * 
  625. * GETOTHERPROMPT()
  626. * 
  627. * Called by sendmail(), getmail(), ulfile(), dlfile(),
  628. * sendcommand(), sendscript()
  629. * 
  630. * Calls findstring(), getcommandprompt()
  631. * 
  632. * For BBSs with a separate File prompt, moves to or from
  633. * the prompt.
  634. * 
  635. *********************************************************************
  636. #endcomment
  637.  
  638. proc getotherprompt
  639. intparm gotoplace
  640. string FilePrompt, BBSType
  641.     profilerd MailRun BBS "BBSType" BBSType
  642.     profilerd MailRun BBS "FilePrompt" FilePrompt
  643.     if !(findstring(prompt, FilePrompt)) && (gotoplace == GOTOFILE)
  644.         transmit "f^M"
  645.     elseif findstring(prompt, FilePrompt) && (gotoplace == GOTOMAIN)
  646.         transmit "q"
  647.         if findstring(BBSType, "RBBS")
  648.             transmit ";m"
  649.         endif
  650.         transmit "^M"
  651.     endif
  652.     getcommandprompt()
  653. endproc
  654.  
  655.  
  656. #comment
  657. *********************************************************************
  658. * 
  659. * CHECKBASESET()
  660. * 
  661. * Called by checkcommandprompt(), checkmailprompt(),
  662. * checkdescprompt()
  663. * 
  664. * Calls findstring()
  665. * 
  666. * Checks the base set of prompts.  Returns 1 if a prompt
  667. * was found; otherwise returns 0.
  668. * 
  669. *********************************************************************
  670. #endcomment
  671.  
  672. func checkbaseset : integer
  673. string LangPrompt, LangNumber, GraphicsPrompt, ScanPrompt
  674. string MorePrompt, ViewPrompt, CallingFrom, UserResp1, UserResp2
  675. string ContinuePrompt, UserPrompt1, UserPrompt2, BBSType
  676.     profilerd MailRun BBS "BBSType" BBSType
  677.     profilerd MailRun BBS "CallingFrom" CallingFrom
  678.     profilerd MailRun BBS "UserPrompt1" UserPrompt1
  679.     profilerd MailRun BBS "UserPrompt2" UserPrompt2
  680.     profilerd MailRun BBS "UserResp1" UserResp1
  681.     profilerd MailRun BBS "UserResp2" UserResp2
  682.     profilerd MailRun BBS "ContinuePrompt" ContinuePrompt
  683.     profilerd MailRun BBS "ScanPrompt" ScanPrompt
  684.     profilerd MailRun BBS "MorePrompt" MorePrompt
  685.     profilerd MailRun BBS "ViewPrompt" ViewPrompt
  686.     profilerd MailRun BBS "LangPrompt" LangPrompt
  687.     profilerd MailRun BBS "GraphicsPrompt" GraphicsPrompt
  688.     if findstring(prompt, UserPrompt1)
  689.         transmit UserResp1
  690.         transmit "^M"
  691.     elseif findstring(prompt, UserPrompt2)
  692.         transmit UserResp2
  693.         transmit "^M"
  694.     elseif findstring(prompt, ScanPrompt) || \
  695.         (findstring(prompt, MorePrompt) && !(findstring(BBSType, "WildCat")))
  696.         transmit "n^M"
  697.     elseif findstring(prompt, MorePrompt) && \
  698.         findstring(BBSType, "WildCat")
  699.         transmit "s^M"
  700.     elseif (findstring(prompt, ContinuePrompt) && \
  701.         findstring(BBSType, "PCBoard")) || \
  702.         findstring(prompt, CallingFrom)
  703.         transmit "y^M"
  704.     elseif findstring(prompt, ContinuePrompt) && \
  705.         !(findstring(BBSType, "PCBoard"))
  706.         transmit "^M"
  707.     elseif findstring(prompt, ViewPrompt)
  708.         if findstring(BBSType, "PCBoard") || findstring(BBSType, "WildCat")
  709.             transmit "n"
  710.         elseif findstring(BBSType, "RBBS")
  711.             transmit "q"
  712.         endif
  713.         transmit "^M"
  714.     elseif findstring(prompt, LangPrompt)
  715.         profilerd MailRun BBS "LangNumber" LangNumber
  716.         transmit LangNumber
  717.         transmit "^M"
  718.     elseif findstring(prompt, GraphicsPrompt)
  719.         profilerd MailRun BBS "GraphicsOn" GraphicsOn
  720.         if GraphicsOn == 0
  721.             transmit "n^M"
  722.         else
  723.             transmit "y^M"
  724.         endif
  725.     else
  726.         return 0
  727.     endif
  728.     return 1
  729. endfunc
  730.  
  731.  
  732. #comment
  733. *********************************************************************
  734. * 
  735. * HOLDING()
  736. * 
  737. * Called by getcommandprompt(), sendmail(), getmail(),
  738. * ulfile(), dlfile(), sendcommand()
  739. *
  740. * Calls capturescreen()
  741. * 
  742. * Jumps to ErrorFail in dobbs()
  743. * 
  744. * Stalls script while waiting for the result of a when
  745. * command.  Sends script to next BBS if there is a
  746. * timeout, or if carrier is lost.
  747. * 
  748. *********************************************************************
  749. #endcomment
  750.  
  751. proc holding
  752. string LastPrompt
  753.     IdleTimer = 1
  754.     holdstatus = 1
  755.     prompt = ""
  756.     xferstatus = $FILEXFER
  757.     while (IdleTimer < IdleTimeout) && (holdstatus == 1) && \
  758.         (xferstatus == 0) && $CARRIER
  759.         pause 1
  760.         termgets $ROW 0 prompt 79
  761.         if not strcmp prompt LastPrompt
  762.             ;if anything has been received, reset the timer
  763.             IdleTimer = 1
  764.         endif
  765.         LastPrompt = prompt
  766.         if !(IdleTimer % 15)
  767.             ;Send a carriage return every 15 seconds
  768.             transmit "^M"
  769.         endif
  770.         IdleTimer++
  771.         xferstatus = $FILEXFER
  772.     endwhile
  773.     if (IdleTimer == IdleTimeout) || ($CARRIER == 0)
  774.         ;If there has been a timeout, lost carrier or user escape...
  775.         clearwhen quiet
  776.         ;set FailCode and get out
  777.         capturescreen()
  778.         if IdleTimer == IdleTimeout
  779.             capturestr "`r`n`r`n*** Timed out waiting for prompt ***`r`n`r`n"
  780.         else
  781.             capturestr "`r`n`r`n*********** Lost carrier ***********`r`n`r`n"
  782.         endif
  783.         longjmp ErrorFail 1
  784.     endif
  785. endproc
  786.  
  787.  
  788. #comment
  789. *********************************************************************
  790. * 
  791. * ENDHOLD()
  792. * 
  793. * Releases a hold placed by holding()
  794. * 
  795. *********************************************************************
  796. #endcomment
  797.  
  798. proc endhold
  799.     holdstatus = 0
  800. endproc
  801.  
  802.  
  803. #comment
  804. *********************************************************************
  805. * 
  806. * WAITXFER()
  807. * 
  808. * Called by sendmail(), getmail(), ulfile(), dlfile()
  809. * 
  810. * Stalls script until a file transfer has been completed.
  811. * 
  812. *********************************************************************
  813. #endcomment
  814.  
  815. proc waitxfer
  816.     xferstatus = $FILEXFER
  817.     while xferstatus == 1
  818.         xferstatus = $FILEXFER
  819.     endwhile
  820. endproc
  821.  
  822.  
  823. #comment
  824. *********************************************************************
  825. * 
  826. * SENDMAIL()
  827. * 
  828. * Called by dobbs()
  829. * 
  830. * Calls checkmailprompt(), holding(), waitxfer(),
  831. * findstring(), makefullname(), getotherprompt(),
  832. * capturescreen()
  833. * 
  834. * Uploads a *.REP packet for the current BBS.
  835. * 
  836. *********************************************************************
  837. #endcomment
  838.  
  839. proc sendmail
  840. string MailULPrompt, MailXferProt, BBSType
  841. string ReplyFile, ReplyDir
  842. string Pending, temp
  843. integer j
  844.     profilerd MailRun BBS "BBSType" BBSType
  845.     profilerd MailRun "MailRun" "ReplyDir" ReplyDir
  846.     ReplyFile = makefullname(ReplyDir, BBS)
  847.     strcat ReplyFile ".REP"
  848.     if isfile ReplyFile
  849.         ;If there is a REP packet waiting...
  850.         if findstring(BBSType, "Auntie") || findstring(BBSType, "RBBS")
  851.             getotherprompt(GOTOMAIN)
  852.         endif
  853.         if findstring(BBSType, "Auntie")
  854.             transmit "QMU^M"
  855.         else
  856.             when quiet 1 call checkmailprompt
  857.             holding()
  858.             clearwhen quiet
  859.             transmit "u^M"
  860.         endif
  861.         profilerd MailRun BBS "MailULPrompt" MailULPrompt
  862.         when target 0 MailULPrompt call endhold
  863.         holding()
  864.         clearwhen target 0
  865.         set upldpath ReplyDir
  866.         profilerd MailRun BBS "MailXferProt" MailXferProt
  867.         sendfile MailXferProt ReplyFile
  868.         ;Hold until the transfer starts
  869.         holding()
  870.         ;Hold until the transfer finishes
  871.         waitxfer()
  872.         if xferstatus == 2
  873.             ;If upload was successful...
  874.             ;Rename the .REP packet as *.OLD
  875.             temp = ReplyFile
  876.             strlen temp j
  877.             j -= 3
  878.             strupdt temp "OLD" j 3
  879.             delfile temp
  880.             rename ReplyFile temp
  881.             ;Mark the Item as completed
  882.             Pending = "0"
  883.             ItemC++
  884.         else
  885.             ;Otherwise, mark it as an error
  886.             Pending = "2"
  887.             ItemE++
  888.             capturescreen()
  889.             capturestr "`r`n`r`n******* Error in File Transfer *******`r`n`r`n"
  890.         endif
  891.     else
  892.         Pending = "0"
  893.         ItemC++
  894.     endif
  895.     ;Update the *.MRN file
  896.     strupdt Item Pending 0 1
  897. endproc
  898.  
  899.  
  900. #comment
  901. *********************************************************************
  902. * 
  903. * GETMAIL()
  904. * 
  905. * Called by dobbs()
  906. * 
  907. * Calls checkmailprompt(), holding(), waitxfer, cleardir(),
  908. * renameqwk(), checkmail(), findstring(), makefullname(),
  909. * getotherprompt(), capturescreen()
  910. * 
  911. * Downloads a *.QWK packet for the current BBS.
  912. * 
  913. *********************************************************************
  914. #endcomment
  915.  
  916. proc getmail
  917. string MailFile, MailDLDir, MailDLPrompt, MailXferProt, CommandPrompt
  918. string Pending, temp, BBSType
  919.     profilerd MailRun BBS "BBSType" BBSType
  920.     foundstatus = 1
  921.     if findstring(BBSType, "Auntie") || findstring(BBSType, "RBBS") 
  922.         getotherprompt(GOTOMAIN)
  923.     endif
  924.     if findstring(BBSType, "Auntie")
  925.         transmit "QMD^M"
  926.     else
  927.         when quiet 1 call checkmailprompt
  928.         holding()
  929.         clearwhen quiet
  930.         transmit "d^M"
  931.         ;Wait for a prompt indicated presense of mail
  932.         when quiet 1 call checkmail
  933.         holding()
  934.         clearwhen quiet
  935.         if foundstatus == 0
  936.             Pending = "0"
  937.             ItemC++
  938.             strupdt Item Pending 0 1
  939.             return
  940.         endif
  941.         ;If there is mail...
  942.         transmit "y^M"
  943.     endif
  944.     ;Wait until asked to start the download
  945.     profilerd MailRun BBS "MailDLPrompt" MailDLPrompt
  946.     profilerd MailRun BBS "CommandPrompt" CommandPrompt
  947.     when target 0 MailDLPrompt call endhold
  948.     when target 1 CommandPrompt call killmaildl
  949.     holding()
  950.     clearwhen target 0
  951.     clearwhen target 1
  952.     ;If the command prompt has put in an appearance, abort the d/l
  953.     if foundstatus == 0
  954.         Pending = "0"
  955.         ItemC++
  956.         strupdt Item Pending 0 1
  957.         return
  958.     endif
  959.     ;Download to the mail download directory
  960.     MailDLDir = makefullname(MailRunDir, "MAILDL")
  961.     mkdir MailDLDir
  962.     cleardir(MailDLDir)
  963.     set dnldpath MailDLDir
  964.     strfmt temp "%s.QWK" BBS
  965.     profilerd MailRun BBS "MailXferProt" MailXferProt
  966.     getfile MailXferProt temp
  967.     ;Hold until the transfer starts
  968.     holding()
  969.     ;Hold until the transfer finishes
  970.     waitxfer()
  971.     if xferstatus == 2
  972.         ;If the download was successful...
  973.         ;Make sure the mail file has the ".QWK" extension.
  974.             ;This complicated workaround is the only way I could
  975.         ;figure out how to get the filename of a file that has
  976.         ;just been downloaded.
  977.         temp = makefullname(MailDLDir, "*.*")
  978.         findfirst temp
  979.         temp = makefullname(MailDLDir, $FILENAME)
  980.         MailFile = makefullname(MailDLDir, BBS)
  981.         strcat MailFile ".QWK"
  982.         rename temp MailFile
  983.         ;Renumber the QWK packets
  984.         renameqwk(MailFile)
  985.         ;and mark it as completed
  986.         Pending = "0"
  987.         ItemC++
  988.     else
  989.         ;Otherwise, mark the item as an error
  990.         Pending = "2"
  991.         ItemE++
  992.         capturescreen()
  993.         capturestr "`r`n`r`n***** Error in File Transfer *****`r`n`r`n"
  994.     endif
  995.     ;Delete the mail download directory
  996.     cleardir(MailDLDir)
  997.     chdir MailRunDir
  998.     rmdir MailDLDir
  999.     strupdt Item Pending 0 1
  1000. endproc
  1001.  
  1002.  
  1003. #comment
  1004. *********************************************************************
  1005. * 
  1006. * CHECKMAIL()
  1007. * 
  1008. * Called by getmail()
  1009. * 
  1010. * Calls findstring(), endhold()
  1011. * 
  1012. * Checks prompt for presense of a mail packet.
  1013. * 
  1014. *********************************************************************
  1015. #endcomment
  1016.  
  1017. proc checkmail
  1018. string ReceiveQWKPrompt, MailPrompt
  1019.     profilerd MailRun BBS "ReceiveQWKPrompt" ReceiveQWKPrompt
  1020.     profilerd MailRun BBS "MailPrompt" MailPrompt
  1021.     if findstring(prompt, MailPrompt)
  1022.         foundstatus = 0
  1023.         endhold()
  1024.     elseif findstring(prompt, ReceiveQWKPrompt)
  1025.         endhold()
  1026.     endif
  1027. endproc
  1028.  
  1029.  
  1030. #comment
  1031. *********************************************************************
  1032. * 
  1033. * KILLMAILDL()
  1034. * 
  1035. * Called by getmail()
  1036. * 
  1037. * If there is no mail packet, kills attempt to d/l.
  1038. * 
  1039. *********************************************************************
  1040. #endcomment
  1041.  
  1042. proc killmaildl
  1043.     foundstatus = 0
  1044.     endhold()
  1045. endproc
  1046.  
  1047.  
  1048. #comment
  1049. *********************************************************************
  1050. * 
  1051. * RENAMEQWK()
  1052. * 
  1053. * Called by getmail()
  1054. * 
  1055. * Calls makefullname()
  1056. * 
  1057. * Renames QWK packets after a successful mail download.
  1058. * 
  1059. *********************************************************************
  1060. #endcomment
  1061.  
  1062. proc renameqwk
  1063. strparm MailFile
  1064. string OldMail1, OldMail2, MailDir
  1065. string char
  1066. integer i, j
  1067.     profilerd MailRun "MailRun" "MailDir" MailDir
  1068.     OldMail2 = makefullname(MailDir, BBS)
  1069.     profilerd MailRun "MailRun" "SavePackets" i
  1070.     ;max of 10 packets
  1071.     if i > 10
  1072.         i = 10
  1073.     endif
  1074.     i -= 1
  1075.     if i > 0
  1076.         strfmt OldMail2 "%s.QW%d" OldMail2 i
  1077.     elseif i == 0
  1078.         strfmt OldMail2 "%s.QW0" OldMail2
  1079.     else
  1080.         strfmt OldMail2 "%s.QWK" OldMail2
  1081.     endif
  1082.     ;Delete oldest file
  1083.     delfile OldMail2
  1084.     OldMail1 = OldMail2
  1085.     strlen OldMail1 j
  1086.     j -= 1
  1087.     while i > 0
  1088.         i--
  1089.         itoa i char
  1090.         strupdt OldMail1 char j 1
  1091.         ;Rename the second oldest as the oldest
  1092.         rename OldMail1 OldMail2
  1093.         ;Rotate filenames
  1094.         OldMail2 = OldMail1
  1095.     endwhile
  1096.     if i == 0
  1097.         ;if the oldest is QW0...
  1098.         strupdt OldMail1 "K" j 1
  1099.         rename OldMail1 OldMail2
  1100.         OldMail2 = OldMail1
  1101.     endif
  1102.     delfile OldMail2
  1103.     copyfile MailFile OldMail1
  1104.     delfile MailFile
  1105. endproc
  1106.  
  1107.  
  1108. #comment
  1109. *********************************************************************
  1110. * 
  1111. * ULFILE()
  1112. * 
  1113. * Called by dobbs()
  1114. * 
  1115. * Calls getconfprompt(), getcommandprompt(), getotherprompt(),
  1116. * holding(), waitxfer(), checkdescprompt(), findstring(),
  1117. * checkverifyprompt(), gotuldlprompt(), senddesc(),
  1118. * capturescreen()
  1119. * 
  1120. * Uploads a file to the current BBS.
  1121. * 
  1122. *********************************************************************
  1123. #endcomment
  1124.  
  1125. proc ulfile
  1126. string Pending, ULPrompt, ULDescPrompt, UploadDir, XferProt
  1127. string FileName, BBSType
  1128.     profilerd MailRun BBS "BBSType" BBSType
  1129.     Pending = "2"
  1130.     strextract FileName Item "," 3
  1131.     strextract Conf item "," 4
  1132.     ;Change conferences if necessary
  1133.     getcommandprompt()
  1134.     if findstring(BBSType, "PCBoard") || findstring(BBSType, "WildCat")
  1135.         getconfprompt()
  1136.     endif
  1137.     if !(findstring(BBSType, "PCBoard"))
  1138.         getotherprompt(GOTOFILE)
  1139.     endif
  1140.     if findstring(BBSType, "WildCat")
  1141.         transmit "u^M"
  1142.         when quiet 1 call checkdescprompt
  1143.         holding()
  1144.         clearwhen quiet
  1145.     else
  1146.         transmit "u;"
  1147.     endif
  1148.     transmit FileName
  1149.     if findstring(BBSType, "Auntie")
  1150.         transmit ";n"
  1151.     endif
  1152.     transmit "^M"
  1153.     ;Check whether file is already on the board
  1154.     when quiet 1 call checkdescprompt
  1155.     holding()
  1156.     clearwhen quiet
  1157.     if foundstatus == 1
  1158.         if !(findstring(BBSType, "RBBS"))
  1159.             senddesc(FileName)
  1160.         endif
  1161.         if findstring(BBSType, "Auntie")
  1162.             when quiet 1 call checkverifyprompt
  1163.             holding()
  1164.             clearwhen quiet
  1165.         endif
  1166.         profilerd MailRun BBS "ULPrompt" ULPrompt
  1167.         when target 0 ULPrompt call gotuldlprompt
  1168.         when quiet 1 call checkdescprompt
  1169.         holding()
  1170.         clearwhen quiet
  1171.         clearwhen target 0
  1172.         xferstatus = 1
  1173.         profilerd MailRun "MailRun" "UploadDir" UploadDir
  1174.         set upldpath UploadDir
  1175.         profilerd MailRun BBS "XferProt" XferProt
  1176.         sendfile XferProt FileName
  1177.         ;Wait until the transfer starts
  1178.         holding()
  1179.         ;Wait until the transfer finishes
  1180.         waitxfer()
  1181.         if xferstatus == 2
  1182.             ;If the download was successful...
  1183.             if findstring(BBSType, "RBBS")
  1184.                 when quiet 1 call checkverifyprompt
  1185.                 holding()
  1186.                 clearwhen quiet
  1187.                 profilerd MailRun BBS "ULDescPrompt" ULDescPrompt
  1188.                 when target 0 ULDescPrompt call endhold
  1189.                 when quiet 1 call checkdescprompt
  1190.                 holding()
  1191.                 clearwhen quiet
  1192.                 clearwhen target 0
  1193.                 if foundstatus == 1
  1194.                     senddesc(FileName)
  1195.                     when quiet 1 call checkdescprompt
  1196.                     holding()
  1197.                     clearwhen quiet
  1198.                 endif
  1199.             endif
  1200.             ;Mark as completed
  1201.             Pending = "0"
  1202.             ItemC++
  1203.         else
  1204.             ;Otherwise, mark as an error
  1205.             ItemE++
  1206.             capturescreen()
  1207.             capturestr "`r`n`r`n***** Error in File Transfer *****`r`n`r`n"
  1208.         endif
  1209.     else
  1210.         ;If the file was already on the board
  1211.         ;Send a carriage return to get the prompt back
  1212.         transmit "^M"
  1213.         if findstring(BBSType, "WildCat")
  1214.             pause 1
  1215.             transmit "A^M"
  1216.         endif
  1217.         ItemC++
  1218.     endif
  1219.     strupdt Item Pending 0 1
  1220. endproc
  1221.  
  1222.  
  1223. #comment
  1224. *********************************************************************
  1225. * 
  1226. * CHECKVERIFYPROMPT()
  1227. * 
  1228. * Called by ulfile()
  1229. * 
  1230. * Calls findstring(), endhold()
  1231. * 
  1232. * Checks for prompt to send the category or file area to
  1233. * which a file should be uploaded.
  1234. * 
  1235. *********************************************************************
  1236. #endcomment
  1237.  
  1238. proc checkverifyprompt
  1239. string BBSType
  1240.     profilerd MailRun BBS "BBSType" BBSType
  1241.     if findstring(BBSType, "Auntie") && findstring(prompt, "editor function")
  1242.         transmit "s^M"
  1243.     elseif findstring(prompt, "category")
  1244.         transmit Conf
  1245.         if findstring(BBSType, "Auntie")
  1246.             transmit ";y;n^M"
  1247.         endif
  1248.         endhold()
  1249.     endif
  1250. endproc
  1251.  
  1252.  
  1253. #comment
  1254. *********************************************************************
  1255. * 
  1256. * SENDDESC()
  1257. * 
  1258. * Called by ulfile()
  1259. * 
  1260. * Calls checkfile(), makefullname(), openfile(), interfaceon(),
  1261. * interfaceoff(), findstring()
  1262. * 
  1263. * Sends the file description of a file to be uploaded;
  1264. * otherwise sends "Description not available".
  1265. * 
  1266. *********************************************************************
  1267. #endcomment
  1268.  
  1269. proc senddesc
  1270. strparm FileName
  1271. string UDXString, UDXFile, MRunUDX, MRunUBF, BBSType
  1272. string DB, DL
  1273. integer char
  1274. long DescBegin, DescLength
  1275. long counter
  1276.     profilerd MailRun BBS "BBSType" BBSType
  1277.     MRunUDX = makefullname(MailRunDir, "MAILRUN.UDX")
  1278.     MRunUBF = makefullname(MailRunDir, "MAILRUN.UBF")
  1279.     ;If the file is not on the board, send a description
  1280.     if checkfile(MRunUDX) && checkfile(MRunUBF)
  1281.         interfaceoff()
  1282.         openfile(MRunUBFFile, MRunUBF, _READWRITE, _NORMAL)
  1283.         openfile(MRunUDXFile, MRunUDX, _READWRITE, _TEXT)
  1284.         fgets MRunUDXFile UDXString
  1285.         strextract UDXFile UDXString "`t" 0
  1286.         while not strcmpi UDXFile FileName
  1287.             fgets MRunUDXFile UDXString
  1288.             strextract UDXFile UDXString "`t" 0
  1289.         endwhile
  1290.         strextract DB UDXString "`t" 4
  1291.         strextract DL UDXString "`t" 5
  1292.         atol DB DescBegin
  1293.         atol DL DescLength
  1294.         if findstring(BBSType, "WildCat")
  1295.             if DescLength > 60
  1296.                 DescLength = 60
  1297.             endif
  1298.         endif
  1299.         if findstring(BBSType, "RBBS")
  1300.             if DescLength > 45
  1301.                 DescLength = 45
  1302.             endif
  1303.         endif
  1304.         fseek MRunUBFFile DescBegin 0
  1305.         for counter = 1 upto DescLength
  1306.             fgetc MRunUBFFile char
  1307.             computc char
  1308.         endfor
  1309.         fclose MRunUBFFile
  1310.         fclose MRunUDXFile
  1311.         interfaceon()
  1312.     else
  1313.         transmit "Description not available"
  1314.     endif
  1315.     transmit "^M"
  1316.     if findstring(BBSType, "PCBoard") || findstring(BBSType, "Auntie")
  1317.         transmit "^M"
  1318.     endif
  1319. endproc
  1320.  
  1321.  
  1322. #comment
  1323. *********************************************************************
  1324. * 
  1325. * DLFILE()
  1326. * 
  1327. * Called by dobbs()
  1328. * 
  1329. * Calls getconfprompt(), getcommandprompt(), getotherprompt(),
  1330. * holding(), waitxfer(), putdesc(), findstring(),
  1331. * checkdescprompt(), gotuldlprompt(), capturescreen()
  1332. * 
  1333. * Downloads a file from the current BBS.
  1334. * 
  1335. *********************************************************************
  1336. #endcomment
  1337.  
  1338. proc dlfile
  1339. string Pending, DLPrompt, DownloadDir, XferProt, FileName, BBSType
  1340.     profilerd MailRun BBS "BBSType" BBSType
  1341.     strextract FileName Item "," 3
  1342.     strextract Conf Item "," 4
  1343.     ;Change conferences if necessary
  1344.     getcommandprompt()
  1345.     if !(findstring(BBSType, "Auntie"))
  1346.         getconfprompt()
  1347.     endif
  1348.     if !(findstring(BBSType, "PCBoard"))
  1349.         getotherprompt(GOTOFILE)
  1350.     endif
  1351.     if findstring(BBSType, "WildCat")
  1352.         transmit "d^M"
  1353.         when quiet 1 call checkdescprompt
  1354.         holding()
  1355.         clearwhen quiet
  1356.     else
  1357.         transmit "d;"
  1358.     endif
  1359.     transmit FileName
  1360.     transmit "^M"
  1361.     ;Check whether file is available for d/l
  1362.     profilerd MailRun BBS "DLPrompt" DLPrompt
  1363.     when target 0 DLPrompt call gotuldlprompt
  1364.     when quiet 1 call checkdescprompt
  1365.     holding()
  1366.     clearwhen quiet
  1367.     clearwhen target 0
  1368.     if foundstatus == 1
  1369.         ;If it is available...
  1370.         profilerd MailRun "MailRun" "DownloadDir" DownloadDir
  1371.         set dnldpath DownloadDir
  1372.         profilerd MailRun BBS "XferProt" XferProt
  1373.         getfile XferProt FileName
  1374.         ;Wait until the transfer starts
  1375.         holding()
  1376.         ;Wait until the transfer finishes
  1377.         waitxfer()
  1378.         if xferstatus == 2
  1379.             ;If the download was successful...
  1380.             putdesc(FileName)
  1381.             ;Mark as completed
  1382.             Pending = "0"
  1383.             ItemC++
  1384.         else
  1385.             ;Otherwise, mark as an error
  1386.             Pending = "2"
  1387.             ItemE++
  1388.             capturescreen()
  1389.             capturestr "`r`n`r`n*** Error in File Transfer ***`r`n`r`n"
  1390.         endif
  1391.     else
  1392.         ;If file was unavailable, mark as error.
  1393.         Pending = "2"
  1394.         ItemE++
  1395.         ;Send a return to get the prompt back.
  1396.         transmit "^M"
  1397.     endif
  1398.     strupdt Item Pending 0 1
  1399. endproc
  1400.  
  1401.  
  1402. #comment
  1403. *********************************************************************
  1404. * 
  1405. * PUTDESC()
  1406. * 
  1407. * Called by dlfile()
  1408. * 
  1409. * Calls openfile(), checkfile(), interfaceoff(), interfaceon(),
  1410. * makefullname()
  1411. * 
  1412. * Searches the BBSs .IDX file for a file description and
  1413. * copies the description from the .DBF file to the uplaod
  1414. * files database.  If no description is found, a line
  1415. * including the file name, size and date is put in the
  1416. * upload files index.
  1417. * 
  1418. *********************************************************************
  1419. #endcomment
  1420.  
  1421. proc putdesc
  1422. strparm FileName
  1423. string DB, DL, idxString, MRunUDX, MRunUBF, BBSidx, BBSdbf
  1424. string idxFile, idxDesc, FileDate, FullFileName, DownloadDir
  1425. integer inidx, char
  1426. long DescBegin, DescLength, counter, FileSize
  1427.     interfaceoff()
  1428.     ;Determine whether the BBS index and database files exist
  1429.     BBSidx = makefullname(MailRunDir, BBS)
  1430.     strfmt BBSdbf "%s.DBF" BBSidx
  1431.     strcat BBSidx ".IDX"
  1432.     inidx = 0
  1433.     if checkfile(BBSidx) && checkfile(BBSdbf)
  1434.         ;If both files exist...
  1435.         openfile(BBSidxFile, BBSidx, _READWRITE, _TEXT)
  1436.         fgets BBSidxFile idxString
  1437.         while not feof BBSidxFile
  1438.             ;Loop through the index file and stop if the file is found
  1439.             strextract idxFile idxString "`t" 0
  1440.             if strcmpi FileName idxFile
  1441.                 inidx = 1
  1442.                 exitwhile
  1443.             endif
  1444.             fgets BBSidxFile idxString
  1445.         endwhile
  1446.         fclose BBSidxFile
  1447.     endif
  1448.     strlwr FileName
  1449.     ;Get the file size and date
  1450.     profilerd MailRun "MailRun" "DownloadDir" DownloadDir
  1451.     FullFileName = makefullname(DownloadDir, FileName)
  1452.     getfsize FullFileName FileSize
  1453.     getfdate FullFileName FileDate
  1454.     ;Determine whether the upload index and database files exist
  1455.     MRunUDX = makefullname(MailRunDir, "MAILRUN.UDX")
  1456.     MRunUBF = makefullname(MailRunDir, "MAILRUN.UBF")
  1457.     if checkfile(MRunUBF) && checkfile(MRunUDX)
  1458.         ;If both files exist, open them
  1459.         openfile(MRunUBFFile, MRunUBF, _READWRITE, _NORMAL)
  1460.         openfile(MRunUDXFile, MRunUDX, _READWRITE, _NORMAL)
  1461.     else
  1462.         ;Otherwise, create them
  1463.         openfile(MRunUBFFile, MRunUBF, _CREATE, _NORMAL)
  1464.         openfile(MRunUDXFile, MRunUDX, _CREATE, _NORMAL)
  1465.     endif
  1466.     fseek MRunUDXFile 0 2
  1467.     if inidx == 1
  1468.         ;If the file was found in the BBS index...
  1469.         strextract idxDesc idxString "`t" 3
  1470.         ;Get the descriptions starting point and length...
  1471.         strextract DB idxString "`t" 4
  1472.         strextract DL idxString "`t" 5
  1473.         atol DB DescBegin
  1474.         atol DL DescLength
  1475.         openfile(BBSdbfFile, BBSdbf, _READWRITE, _NORMAL)
  1476.         fseek BBSdbfFile DescBegin 0
  1477.         fseek MRunUBFFile 0 2
  1478.         ftell MRunUBFFile DescBegin
  1479.         ;And copy each character of the description to the upload database
  1480.         for counter = 1 upto DescLength
  1481.             fgetc BBSdbfFile char
  1482.             fputc MRunUBFFile char
  1483.         endfor
  1484.         fclose BBSdbfFile
  1485.         ;Format the upload index entry
  1486.         fstrfmt MRunUDXFile "%s`t%ld`t%s`t%s`t%ld`t%ld`r`n" \
  1487.             FileName FileSize FileDate idxDesc DescBegin DescLength
  1488.     else
  1489.         ;If there was no entry in the BBS index...
  1490.         ;Format the upload index entry
  1491.         fstrfmt MRunUDXFile "%s`t%ld`t%s`t`t0`t0`r`n" FileName FileSize FileDate
  1492.     endif
  1493.     fclose MRunUBFFile
  1494.     fclose MRunUDXFile
  1495.     interfaceon()
  1496. endproc
  1497.  
  1498.  
  1499. #comment
  1500. *********************************************************************
  1501. * 
  1502. * SENDCOMMAND()
  1503. * 
  1504. * Called by dobbs()
  1505. * 
  1506. * Calls getcommandprompt(), getotherprompt(), holding(), 
  1507. * findstring()
  1508. * 
  1509. * Sends commands to the current BBS.  A command item may
  1510. * contain multiple command lines separated by a vertical
  1511. * bar.  The script will send these one at a time, waiting
  1512. * until the terminal has been quiet for 15 seconds before
  1513. * sending the next one.  The command must return the user
  1514. * to the Main Command Prompt, or be the last item for the
  1515. * BBS.
  1516. * 
  1517. *********************************************************************
  1518. #endcomment
  1519.  
  1520. proc sendcommand
  1521. string CommandLine, Command, BBSType
  1522. integer j
  1523.     getcommandprompt()
  1524.     profilerd MailRun BBS "BBSType" BBSType
  1525.     if !(findstring(BBSType, "PCBoard"))
  1526.         getotherprompt(GOTOMAIN)
  1527.     endif
  1528.     strextract Command Item "," 3
  1529.     j = 0
  1530.     strextract CommandLine Command "|" j
  1531.     while not NULLSTR CommandLine
  1532.         if j != 0
  1533.             when quiet 10 call endhold
  1534.             holding()
  1535.             clearwhen quiet
  1536.         endif
  1537.         transmit CommandLine
  1538.         transmit "^M"
  1539.         j++
  1540.         strextract CommandLine Command "|" j
  1541.     endwhile
  1542.     strupdt Item "0" 0 1
  1543. endproc
  1544.  
  1545.  
  1546. #comment
  1547. *********************************************************************
  1548. * 
  1549. * SENDSCRIPT()
  1550. * 
  1551. * Called by dobbs()
  1552. * 
  1553. * Calls getcommandprompt(), getotherprompt(), mailrunbox(),
  1554. * findstring(), makefullname()
  1555. * 
  1556. * Executes a script file.  The script must return to the
  1557. * Main Command Prompt, or be the last item for that BBS.
  1558. * 
  1559. *********************************************************************
  1560. #endcomment
  1561.  
  1562. proc sendscript
  1563. string ScriptName, BBSType
  1564.     getcommandprompt()
  1565.     profilerd MailRun BBS "BBSType" BBSType
  1566.     if !(findstring(BBSType, "PCBoard"))
  1567.         getotherprompt(GOTOMAIN)
  1568.     endif
  1569.     strextract ScriptName Item "," 3
  1570.     ScriptName = makefullname(MailRunDir, ScriptName)
  1571.     execute ScriptName
  1572.     strupdt Item "0" 0 1
  1573.     mailrunbox()
  1574. endproc
  1575.  
  1576.  
  1577. #comment
  1578. *********************************************************************
  1579. * 
  1580. * LOGOFF()
  1581. * 
  1582. * Called by dobbs()
  1583. * 
  1584. * Logs off the current BBS.
  1585. * 
  1586. *********************************************************************
  1587. #endcomment
  1588.  
  1589. proc logoff
  1590. integer i = 1
  1591.     if $CARRIER
  1592.         transmit "g^M"
  1593.     endif
  1594.     pause 5
  1595.     while $CARRIER && (i < 3)
  1596.         hangup
  1597.         pause 5
  1598.         i++
  1599.     endwhile
  1600. endproc
  1601.  
  1602.  
  1603. #comment
  1604. *********************************************************************
  1605. * 
  1606. * MAILRUNBOX()
  1607. * 
  1608. * Called by main(), sendscript()
  1609. * 
  1610. * Draws the main MailRun dialog box.
  1611. * 
  1612. *********************************************************************
  1613. #endcomment
  1614.  
  1615. proc mailrunbox
  1616. destroydlg
  1617. MainBoxTabs = "20,30,220,230,233,236,239,242"
  1618. HelpPage = 2
  1619. dialogbox 8 36 346 181 15 "MailRun" HELPID HelpPage
  1620.    groupbox 10 33 228 135 "Task List" shadow
  1621.    flistbox 15 52 218 102 TaskList MainBoxTabs single TaskItem
  1622.    text  15 153 49 8 left "# = permanent"
  1623.    text  76 153 49 8 left "ñ = temporary"
  1624.    text  140 153 33 8 left "! = error"
  1625.    text  182 153 53 8 left "@ = completed"
  1626.    groupbox 244 33 90 135 "Statistics" shadow
  1627.    text  248 55 62 8 right "BBSs in mailrun:"
  1628.    text  248 69 62 8 right "BBSs completed:"
  1629.    text  248 83 62 8 right "BBSs left to call:"
  1630.    text  248 97 62 8 right "Items in mailrun:"
  1631.    text  248 111 62 8 right "Items completed:"
  1632.    text  248 125 62 8 right "Item errors:"
  1633.    text  248 139 62 8 right "Items remaining:"
  1634.    text  248 153 62 8 right "Dialing Attempt:"
  1635.    vtext 314 55 16 9 left BBSTotal
  1636.    vtext 314 69 16 9 left BBSComplete
  1637.    vtext 314 83 16 9 left BBSRemaining
  1638.    vtext 314 97 16 9 left ItemTotal
  1639.    vtext 314 111 16 9 left ItemComplete
  1640.    vtext 314 125 16 9 left ItemError
  1641.    vtext 314 139 16 9 left ItemRemaining
  1642.    vtext 314 153 16 9 left AttemptNum
  1643.    text  102 14 74 8 right "The current mailrun is:"
  1644.    combobox 180 12 76 41 MailRunTrunc MailRunTrunc
  1645.    pushbutton 0 0 0 0 "          &t" normal default
  1646.    pushbutton 0 0 0 0 "          &u" normal
  1647.    pushbutton 0 0 0 0 "          &i" normal
  1648. enddialog
  1649. disable CTRL 170
  1650. endproc
  1651.  
  1652.  
  1653. #comment
  1654. *********************************************************************
  1655. * 
  1656. * CAPTURESCREEN()
  1657. * 
  1658. * Called by main(), holding(), sendmail(), getmail(),
  1659. * ulfile(), dlfile()
  1660. * 
  1661. * Puts the current screen in the capture file.  Normally, the
  1662. * contents of a terminal screen are not placed in the capture
  1663. * file until they scroll off.  If a capture string is placed in
  1664. * a capture file, it will appear before the last screenfull of
  1665. * data.  This procedure is necessary to ensure that a capture
  1666. * string appears after all data that has already been received
  1667. * from the remote.
  1668. * 
  1669. *********************************************************************
  1670. #endcomment
  1671.  
  1672. proc capturescreen
  1673. string RowString
  1674. integer Row, MaxRows, MaxCols
  1675.     fetch terminal rows MaxRows
  1676.     fetch terminal columns MaxCols
  1677.     for Row = 0 upto MaxRows
  1678.         termgets Row 0 RowString MaxCols
  1679.         capturestr RowString
  1680.         capturestr "`r`n"
  1681.     endfor
  1682.     termreset
  1683. endproc
  1684.         
  1685.